home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / ShareMailGiftware / AmigaTalk / system / GamePort.st < prev    next >
Text File  |  2002-10-27  |  8KB  |  328 lines
  1. " ---------------------------------------------------------------------"
  2. " GamePort Class is an abstract Class that allows the user of AmigaTalk"
  3. " to utilize the GamePort Device that the Amiga PC uses to detect      "
  4. " input events, such as mouse movement or button clicks or joystick    "
  5. " movement. "
  6. " ---------------------------------------------------------------------"
  7. "  WARNING:  You should know what you're doing to the Amiga OS before  "
  8. "            messing with this Class, or any other System Class!       "
  9. " ---------------------------------------------------------------------"
  10.  
  11. Class GamePort :Device
  12. [
  13.   openGamePort: whichUnit
  14.     ^ super subclassResponsibility: 'openGamePort:'
  15. |
  16.   getControllerType: portObject
  17.     "The integer returned by this method is one of the following: "
  18.  
  19.      "  GPCT_ALLOCATED    -1"
  20.      "  GPCT_NOCONTROLLER  0"
  21.      "  GPCT_MOUSE         1" 
  22.      "  GPCT_RELJOYSTICK   2"
  23.      "  GPCT_ABSJOYSTICK   3"
  24.     ^ <primitive 223 7 portObject>
  25. |
  26.   new: dummy
  27.     ^ super doesNotUnderstand: 'new:' 
  28. ]
  29.  
  30. " -------------------------------------------------------------------- "
  31. " Mouse Class allows the User to setup & use a Mouse.                  "
  32. " -------------------------------------------------------------------- "
  33.  
  34. Class Mouse :GamePort ! private !
  35. [
  36.   getControllerType
  37.     ^ (super getControllerType: private)
  38. |
  39.   openMousePort: whichUnit ! chk !
  40.     private <- <primitive 223 1 whichUnit>.
  41.  
  42.     chk <- <primitive 223 7 private>.
  43.  
  44.     (chk == 0)    " Port NOT being used?? "
  45.        ifTrue:  [ <primitive 223 8 private 1>.  "GPCT_MOUSE <- 1"
  46.                   ^ self
  47.                 ]
  48.        ifFalse: [ self error: 'Mouse port ',whichUnit,' already in use!'. 
  49.                   ^ nil
  50.                 ]
  51. |   
  52.   closeMousePort
  53.     <primitive 223 0 private>
  54. |
  55.   clearMousePortBuffer
  56.     <primitive 223 6 private>
  57. |
  58.   getButtonCode
  59.     ^ <primitive 223 10 private>
  60. |
  61.   getQualifiers
  62.     ^ <primitive 223 11 private>
  63. |
  64.   getXPos
  65.     ^ <primitive 223 12 private>
  66. |
  67.   getYPos
  68.     ^ <primitive 223 13 private>
  69. |
  70.   getIEAddress
  71.     ^ <primitive 223 14 private>
  72. |
  73.   getTimeStamp
  74.     ^ <primitive 223 15 private>
  75. |   
  76.   getTriggerKeys
  77.     ^ <primitive 223 16 private>
  78. |
  79.   getTriggerTime
  80.     ^ <primitive 223 17 private>
  81. |         
  82.   getTriggerXDelta
  83.     ^ <primitive 223 18 private>
  84. |
  85.   getTriggerYDelta
  86.     ^ <primitive 223 19 private>
  87. |
  88.   setKeyTransition: transType
  89.  
  90.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  91.  
  92.     (transType >= 1 & transType <= 3)
  93.       ifTrue:  [ <primitive 223 2 private transType> ]
  94.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  95. |
  96.   setTimeTransition: timeOutValue
  97.     (timeOutValue < 0)
  98.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  99.                 ^ nil 
  100.               ].
  101.     <primitive 223 3 private timeOutValue>
  102. |
  103.   setXDeltaTransition: xvalue
  104.     <primitive 223 4 private xvalue>
  105. |
  106.   setYDeltaTransition: yvalue
  107.     <primitive 223 5 private yvalue>
  108. |
  109.   waitForButton:    kvalue ! ret !
  110.     ret <- self getButtonCode.
  111.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  112. |
  113.   waitForQualifier: qvalue ! ret !
  114.     ret <- self getQualifiers.
  115.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  116. |
  117.   waitForXPos: xvalue ! ret !
  118.     ret <- self getXPos.
  119.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  120. |
  121.   waitForYPos: yvalue ! ret !
  122.     ret <- self getYPos.
  123.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  124. |
  125.   new: whichUnit
  126.     ^ (self openMousePort: whichUnit)
  127. ]
  128.  
  129. " -------------------------------------------------------------------- "
  130. " AbsJoyStick Class allows the User to setup & use an Absolute-type    "
  131. " JoyStick."
  132. " -------------------------------------------------------------------- "
  133.  
  134. Class AbsJoyStick :GamePort ! private !
  135. [
  136.   getControllerType
  137.     ^ (super getControllerType: private)
  138. |
  139.   openGamePort: whichUnit ! chk !
  140.     private <- <primitive 223 1 whichUnit>.
  141.  
  142.     chk <- <primitive 223 7 private>.
  143.  
  144.     (chk == 0)
  145.        ifTrue:  [ <primitive 223 8 private 3>. "GPCT_ABSJOYSTICK <- 3"
  146.                   ^ self
  147.                 ]
  148.        ifFalse: [ self error: 'Game port ',whichUnit,' already in use!'. 
  149.                   ^ nil
  150.                 ]
  151. |   
  152.   closeGamePort
  153.     <primitive 223 0 private>
  154. |
  155.   clearGamePortBuffer
  156.     <primitive 223 6 private>
  157. |
  158.   getButtonCode
  159.     ^ <primitive 223 10 private>
  160. |
  161.   getQualifiers
  162.     ^ <primitive 223 11 private>
  163. |
  164.   getXPos
  165.     ^ <primitive 223 12 private>
  166. |
  167.   getYPos
  168.     ^ <primitive 223 13 private>
  169. |
  170.   getIEAddress
  171.     ^ <primitive 223 14 private>
  172. |
  173.   getTimeStamp
  174.     ^ <primitive 223 15 private>
  175. |   
  176.   getTriggerKeys
  177.     ^ <primitive 223 16 private>
  178. |
  179.   getTriggerTime
  180.     ^ <primitive 223 17 private>
  181. |         
  182.   getTriggerXDelta
  183.     ^ <primitive 223 18 private>
  184. |
  185.   getTriggerYDelta
  186.     ^ <primitive 223 19 private>
  187. |
  188.   setKeyTransition: transType
  189.  
  190.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  191.  
  192.     (transType >= 1 & transType <= 3)
  193.       ifTrue:  [ <primitive 223 2 private transType> ]
  194.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  195. |
  196.   setTimeTransition: timeOutValue
  197.     (timeOutValue < 0)
  198.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  199.                 ^ nil 
  200.               ].
  201.     <primitive 223 3 private timeOutValue>
  202. |
  203.   setXDeltaTransition: xvalue
  204.     <primitive 223 4 private xvalue>
  205. |
  206.   setYDeltaTransition: yvalue
  207.     <primitive 223 5 private yvalue>
  208. |
  209.   waitForButton:    kvalue ! ret !
  210.     ret <- self getButtonCode.
  211.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  212. |
  213.   waitForQualifier: qvalue ! ret !
  214.     ret <- self getQualifiers.
  215.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  216. |
  217.   waitForXPos: xvalue ! ret !
  218.     ret <- self getXPos.
  219.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  220. |
  221.   waitForYPos: yvalue ! ret !
  222.     ret <- self getYPos.
  223.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  224. |
  225.   new: whichUnit
  226.     ^ (self openGamePort: whichUnit)
  227. ]
  228.  
  229. " -------------------------------------------------------------------- "
  230. " RelJoyStick Class allows the User to setup & use a Relative-type     "
  231. " JoyStick."
  232. " -------------------------------------------------------------------- "
  233.  
  234. Class RelJoyStick :GamePort ! private !
  235. [
  236.   getControllerType
  237.     ^ (super getControllerType: private)
  238. |
  239.   openGamePort: whichUnit ! chk !
  240.     private <- <primitive 223 1 whichUnit>.
  241.  
  242.     chk <- <primitive 223 7 private>.
  243.  
  244.     (chk == 0)
  245.        ifTrue:  [ <primitive 223 8 private 2>. "GPCT_RELJOYSTICK <- 2"
  246.                   ^ self
  247.                 ]
  248.        ifFalse: [ self error: 'Game port ',whichUnit,' already in use!'. 
  249.                   ^ nil
  250.                 ]
  251. |   
  252.   closeGamePort
  253.     <primitive 223 0 private>
  254. |
  255.   clearGamePortBuffer
  256.     <primitive 223 6 private>
  257. |
  258.   getButtonCode
  259.     ^ <primitive 223 10 private>
  260. |
  261.   getQualifiers
  262.     ^ <primitive 223 11 private>
  263. |
  264.   getXPos
  265.     ^ <primitive 223 12 private>
  266. |
  267.   getYPos
  268.     ^ <primitive 223 13 private>
  269. |
  270.   getIEAddress
  271.     ^ <primitive 223 14 private>
  272. |
  273.   getTimeStamp
  274.     ^ <primitive 223 15 private>
  275. |   
  276.   getTriggerKeys
  277.     ^ <primitive 223 16 private>
  278. |
  279.   getTriggerTime
  280.     ^ <primitive 223 17 private>
  281. |         
  282.   getTriggerXDelta
  283.     ^ <primitive 223 18 private>
  284. |
  285.   getTriggerYDelta
  286.     ^ <primitive 223 19 private>
  287. |
  288.   setKeyTransition: transType
  289.  
  290.     "GPTF_UPKEYS = 2, GPTF_DOWNKEYS = 1 or GPTF_DOWNKEYS + GPTF_UPKEYS:"
  291.  
  292.     (transType >= 1 & transType <= 3)
  293.       ifTrue:  [ <primitive 223 2 private transType> ]
  294.       ifFalse: [ 'transType parameter out of range (1 to 3 only)!' print ]
  295. |
  296.   setTimeTransition: timeOutValue
  297.     (timeOutValue < 0)
  298.       ifTrue: [ 'timeOutValue out of range (S/B >= 0).' print.
  299.                 ^ nil 
  300.               ].
  301.     <primitive 223 3 private timeOutValue>
  302. |
  303.   setXDeltaTransition: xvalue
  304.     <primitive 223 4 private xvalue>
  305. |
  306.   setYDeltaTransition: yvalue
  307.     <primitive 223 5 private yvalue>
  308. |
  309.   waitForButton:    kvalue ! ret !
  310.     ret <- self getButtonCode.
  311.     [ret = kvalue] whileFalse: [ret <- self getButtonCode]
  312. |
  313.   waitForQualifier: qvalue ! ret !
  314.     ret <- self getQualifiers.
  315.     [ret = qvalue] whileFalse: [ret <- self getQualifiers]
  316. |
  317.   waitForXPos: xvalue ! ret !
  318.     ret <- self getXPos.
  319.     [ret = xvalue] whileFalse: [ret <- self getXPos]
  320. |
  321.   waitForYPos: yvalue ! ret !
  322.     ret <- self getYPos.
  323.     [ret = yvalue] whileFalse: [ret <- self getYPos]
  324. |
  325.   new: whichUnit
  326.     ^ (self openGamePort: whichUnit)
  327. ]
  328.